home *** CD-ROM | disk | FTP | other *** search
/ Delphi Programmer's Power Pack / Delphi Volume 1.iso / e_to_l / fbuilder / delphi / demos / mainform.pas < prev    next >
Pascal/Delphi Source File  |  1996-09-15  |  15KB  |  538 lines
  1. { FormulaBuilder 1.0 }
  2. { YGB Software, Inc. }
  3. { Copyright 1995 Clayton Collie }
  4. { All Rights Reserved           }
  5.  
  6. {* Main Form of the main FormulaBuilder Demo *}
  7.  
  8. unit Mainform;
  9. interface
  10. uses
  11.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  12.   Forms, Dialogs, TabNotBk, StdCtrls, Buttons, ExtCtrls, DB,
  13.   DBTables, Grids, DBGrids,DBCtrls,
  14.   FBCalc,FBComp,FBDBComp,
  15.   FiltrFrm,FuncDlg,extfunc,
  16.   DBExprFm, VBXCtrl, Chart2fx, Outline,
  17.   fb_rtti,FBRTCOMP;
  18.  
  19. type
  20.   TMainDemoFm = class(TForm)
  21.     Notebook: TTabbedNotebook;
  22.     ResultsPanel: TPanel;
  23.     Panel1: TPanel;
  24.     ExpressionListbox: TListBox;
  25.     Panel2: TPanel;
  26.     btnFunctions: TBitBtn;
  27.     CancelBtn: TBitBtn;
  28.     SpeedButton2: TSpeedButton;
  29.     CustomerGrid: TDBGrid;
  30.     CustomerTable: TTable;
  31.     CustomerDataSource: TDataSource;
  32.     Panel5: TPanel;
  33.     OrdersGrid: TDBGrid;
  34.     OrdersTable: TTable;
  35.     OrdersDataSource: TDataSource;
  36.     Panel8: TPanel;
  37.     OrdersResultPanel: TPanel;
  38.     Panel9: TPanel;
  39.     cbxApplyCustomerFilter: TCheckBox;
  40.     OrdersTableOrderNo: TFloatField;
  41.     OrdersTableCustNo: TFloatField;
  42.     OrdersTableSaleDate: TDateTimeField;
  43.     OrdersTableShipDate: TDateTimeField;
  44.     OrdersTableEmpNo: TIntegerField;
  45.     OrdersTableTerms: TStringField;
  46.     OrdersTablePaymentMethod: TStringField;
  47.     OrdersTableItemsTotal: TCurrencyField;
  48.     OrdersTableTaxRate: TFloatField;
  49.     OrdersTableFreight: TCurrencyField;
  50.     OrdersTableAmountPaid: TCurrencyField;
  51.     btnCustomerFilter: TBitBtn;
  52.     btnOrdersFilter: TBitBtn;
  53.     cbxApplyOrdersFilter: TCheckBox;
  54.     Formula: TBitBtn;
  55.     ChartFX1: TChartFX;
  56.     GroupBox1: TGroupBox;
  57.     ResultMemo: TMemo;
  58.     ExpressionGroupBox: TGroupBox;
  59.     ExpressionCombo: TComboBox;
  60.     VariablesBtn: TSpeedButton;
  61.     CalcBtn: TSpeedButton;
  62.     Panel3: TPanel;
  63.     FormulaEdit: TEdit;
  64.     XMinEdit: TEdit;
  65.     XMaxEdit: TEdit;
  66.     NumPtsEdit: TEdit;
  67.     btnDrawGraph: TSpeedButton;
  68.     Label1: TLabel;
  69.     Label2: TLabel;
  70.     Label3: TLabel;
  71.     Label4: TLabel;
  72.     newFuncsCombo: TComboBox;
  73.     NewFuncsListbox: TListBox;
  74.     RunBtn: TSpeedButton;
  75.     runmemo: TMemo;
  76.     RegisterFuncBtn: TBitBtn;
  77.     UnregisterBtn: TBitBtn;
  78.     HelpBtn: TBitBtn;
  79.     btnAbout: TSpeedButton;
  80.     Bevel1: TBevel;
  81.     SimpleExpression: TExpression;
  82.     CustomersFilter: TDSFilter;
  83.     OrdersFilter: TDSFilter;
  84.     OrdersExpression: TDBExpression;
  85.     lblCustomerGrid: TLabel;
  86.     lblOrdersGrid: TLabel;
  87.     CustomerTableCustNo: TFloatField;
  88.     CustomerTableCompany: TStringField;
  89.     CustomerTableAddr1: TStringField;
  90.     CustomerTableCity: TStringField;
  91.     CustomerTableState: TStringField;
  92.     CustomerTableZip: TStringField;
  93.     CustomerTableCountry: TStringField;
  94.     CustomerTablePhone: TStringField;
  95.     CustomerTableFAX: TStringField;
  96.     CustomerTableTaxRate: TFloatField;
  97.     CustomerTableContact: TStringField;
  98.     CustomerTableLastInvoiceDate: TDateTimeField;
  99.     lblDemo: TLabel;
  100.     BitBtn1: TBitBtn;
  101.     Panel4: TPanel;
  102.     Panel6: TPanel;
  103.     Memo2: TMemo;
  104.     MainLabel: TLabel;
  105.     procedure btnFunctionsClick(Sender: TObject);
  106.     procedure FormCreate(Sender: TObject);
  107.     procedure FilterBtnClick(Sender: TObject);
  108.     procedure btnOrdersFilterClick(Sender: TObject);
  109.     procedure cbxApplyCustomerFilterClick(Sender: TObject);
  110.     procedure FormulaClick(Sender: TObject);
  111.     procedure CustomerDataSourceDataChange(Sender: TObject; Field: TField);
  112.     procedure OrdersDataSourceDataChange(Sender: TObject; Field: TField);
  113.     procedure cbxApplyOrdersFilterClick(Sender: TObject);
  114.     procedure CalcBtnClick(Sender: TObject);
  115.     procedure VariablesBtnClick(Sender: TObject);
  116.     procedure ExpressionListboxDblClick(Sender: TObject);
  117.     procedure btnDrawGraphClick(Sender: TObject);
  118.     procedure RegisterFuncBtnClick(Sender: TObject);
  119.     procedure UnregisterBtnClick(Sender: TObject);
  120.     procedure RunBtnClick(Sender: TObject);
  121.     procedure NewFuncsListboxClick(Sender: TObject);
  122.     procedure HelpBtnClick(Sender: TObject);
  123.     procedure btnAboutClick(Sender: TObject);
  124.     procedure BitBtn1Click(Sender: TObject);
  125.   private
  126.     { Private declarations }
  127.     { Page 1 - Filter and DBExpression Demo }
  128.     Xmax,XMin                 : double;
  129.     OldNumpts,NumPts          : longint;
  130.     GraphFormula              : string[150];
  131.     Function  CollectGraphOpts : boolean;
  132.     Procedure PlotGraph;
  133.     Procedure UpdateCustomerGrid;
  134.     Procedure UpdateOrdersGrid;
  135.     Procedure UpdateOrderCalc;
  136.     Procedure RunFunc;
  137.     { RTTI }
  138.   public
  139.     { Public declarations }
  140.   end;
  141.  
  142. var
  143.   MainDemoFm: TMainDemoFm;
  144.  
  145. implementation
  146. uses FBMisc,VarDlg,ChartFX,FBHelpFm,demabout,typinfo,WarnDlg,RTTIFm;
  147. {$R *.DFM}
  148.  
  149. Const ALLTYPES = [vtSTRING,vtINTEGER,vtFLOAT,vtBOOLEAN,vtDATE,vtCHAR,vtANY];
  150. const DBExpr =
  151. '[Customer->Company] + " paid $"+str([Orders->AmountPaid],2) + '+
  152. '" on order #"+Str([Orders->OrderNo])+ " on " + '+
  153. 'DateToStr([Orders->SaleDate])+". Payment was by " + '+
  154.                '[Orders->PaymentMethod]';
  155.  
  156.       CustExpr = 'Company + " is in " +City+" " +State+" "+Zip';
  157.  
  158.       OrderExpr = '"Customer #"+Str(CustNo)+" Owes $"+str(ItemsTotal-AmountPaid,2) + '+
  159.                   '" on Order # "+Str(OrderNo)';
  160.  
  161.  
  162. Function RemoveCRLF(const s : string):string;
  163. var a,b : string;
  164. begin
  165.   SplitByDelim(s,#13#10,a, b);
  166.   result := a + b;
  167. end;
  168.  
  169.  
  170. procedure TMainDemoFm.btnFunctionsClick(Sender: TObject);
  171. begin
  172.    DisplayFunctionList;
  173. end;
  174.  
  175. procedure TMainDemoFm.FormCreate(Sender: TObject);
  176. var proplist : TStringList;
  177. begin
  178.    CustomerTable.Active := True;  { Do this only on enter page 1 ?}
  179.    OrdersTable.Active   := True;
  180.    {::::::}
  181.    OrdersExpression.Database := OrdersTable.Database;
  182.    OrdersExpression.Formula  := DBExpr;
  183.    { UpdateOrderCalc }
  184.    RunBtn.Enabled := False;
  185.  end;
  186.  
  187.  
  188.  
  189. {/%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
  190. { Page 1 - Basic Demo                                                  }
  191. {::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
  192.  
  193. procedure TMainDemoFm.CalcBtnClick(Sender: TObject);
  194. var s: String;
  195.  
  196.       Procedure DispError;
  197.       begin
  198.         ResultMemo.Text := SimpleExpression.StatusText;
  199.         MessageBeep(MB_ICONHAND);
  200.       end;
  201.  
  202. begin
  203.    s := ExpressionCombo.Text;
  204.    if (s[1] = ';') OR (s = '') then exit;  { ignore comments and blank lines }
  205.    with simpleExpression do
  206.    begin
  207.      Formula := S;
  208.      if Status = EXPR_SUCCESS then
  209.      begin
  210.        ResultMemo.Text := AsString;
  211.        if Status = EXPR_SUCCESS then
  212.           ExpressionCombo.Items.Add(s)
  213.         else
  214.           DispError;
  215.      end
  216.     else
  217.       DispError;
  218.    end;
  219. end;
  220.  
  221.  
  222. procedure TMainDemoFm.VariablesBtnClick(Sender: TObject);
  223. begin
  224.    ManageVariables(SimpleExpression.Handle);
  225. end;
  226.  
  227. procedure TMainDemoFm.ExpressionListboxDblClick(Sender: TObject);
  228. var s : string;
  229. begin
  230.    with ExpressionListBox do
  231.    if itemIndex > 0 then
  232.    begin
  233.      s := items[ItemIndex];
  234.      if s[1] <> ';' then
  235.         ExpressionCombo.Text := s;
  236.    end;
  237. end;
  238.  
  239.  
  240.  
  241. {*                                   *}
  242. {* Page 2 - BDE Expression Demo      *}
  243. {* Utilizes all the Data-Aware Types *}
  244. {*                                   *}
  245.  
  246. Procedure TMainDemoFm.UpdateCustomerGrid;
  247. begin
  248.   CustomersFilter.Refresh;
  249.   CustomerGrid.Invalidate; 
  250.   CustomerTable.First;
  251. end;
  252.  
  253. Procedure TMainDemoFm.UpdateOrdersGrid;
  254. begin
  255.   OrdersFilter.Refresh;
  256.   OrdersGrid.Invalidate;
  257.   OrdersTable.First;
  258. end;
  259.  
  260. Procedure TMainDemoFm.UpdateOrderCalc;
  261. begin
  262.   if (not Assigned(OrdersExpression)) or OrdersExpression.isNull then
  263.      OrdersResultPanel.Caption := ''
  264.    else
  265.      OrdersResultPanel.Caption := ' > '+RemoveCRLF(OrdersExpression.AsString);
  266. end;
  267.  
  268.  
  269. procedure TMainDemoFm.btnOrdersFilterClick(Sender: TObject);
  270. begin
  271.   if BuildDSExpression('Orders Filter Expression',[vtBoolean],
  272.                         OrdersFilter,OrdersTable) then
  273.                         UpdateOrdersGrid;
  274. end;
  275.  
  276. procedure TMainDemoFm.FilterBtnClick(Sender: TObject);
  277. begin
  278.   if Bu